perm filename WRDGET[S,AIL]1 blob
sn#000862 filedate 1972-09-21 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00011 PAGES VERSION 16-2(1)
RECORD PAGE DESCRIPTION
00001 00001
00002 00002 HISTORY
00003 00003 DSCR REMEMB,FORGET,RESTOR
00013 00004 COPSTR: COPY STRING
00018 00005 DSCR FORGET
00023 00006 DSCR RESTOR RESTORE CONTENTS OF VARIABLES
00026 00007 RESFND: FOUND MATCH
00028 00008
00029 00009 DSCR ALLRM,ALLFOR,ALLRS.
00031 00010 DSCR GFREES
00039 00011
00040 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021 202000000001 ⊗;
COMMENT ⊗
VERSION 16-2(1) 9-21-72 BY JRL PUT IN VERSION NUMBER
⊗;
DSCR REMEMB,FORGET,RESTOR
⊗
DESC ←← 400000 ;INDICATES A DESCRIPTOR OF SOME SORT
ISARR ←← 200000 ;ARRAY
ISSTR ←← 100000 ;STRING
ISSET ←← 40000 ;SET OR LIST
HERE(REMEMB)
PUSHJ P,STACSV ;SAVE OFF ACCUMULATORS
MOVE TABL,GOGTAB ;USER TABLE
POP P,LPSA ;RETURN ADDRESS
POP P,D ;REF TO CONTEXT
SKIPN FP,FP2(TABL) ;ANY TWO WORD FREES YET
PUSHJ P,FP2DON ;NO GO GET SOME
MOVEM FP,FP2(TABL)
LPREM:
POP P,A ;VAR TO BE SAVED
JUMPE A,RETALL ;IF THROUGH, RETURN
TLNE A,ISARR ;IF ARRAY GET DESCRIPTOR
HRR A,(A)
TRNN A,-1 ;IF NOTHING THERE, TROUBLE
ERR <REMEMBER: MISSING ARRAY DESCRIPTOR>,1
MOVEI B,(D) ;START LOOKING AT HEAD OF CONTEXT LIST
HRRZ C,(B)
JUMPE C,INSERT ;NIL CONTEXT LIST?
LPREM2:
HLRZ PNT,(C) ;CANDIDATE
CAIN PNT,(A) ;SAME AS OUR PARM.
JRST REMREP ;YES.
CAIL PNT,(A) ;FURTHER DOWN LIST?
JRST INSERT ;NO.
;AT THIS POINT WE HAVE DETERMINED THAT THE ADDRESS OF THE PARAMETER
;IS GREATER THAT THE ADDRESS OF THE STORED VALUE, BUT THE PARAMETER
;MAY STILL BE AN ELEMENT OF A STORED ARRAY
MOVE TEMP,(C) ;DESC BIT ON IF MIGHT BE ARRAY
TLNN A,ISARR ;IS PARAM AN ARRAY
TRNN TEMP,DESC ;STORED ONE A DESCRIPTOR
JRST REMCDR ;NOT ELEM OF STORED ARRAY.
MOVE TEMP,1(C) ;GET DESCRIPTOR
TLNN TEMP,ISARR ;STORED ARRAY?
JRST REMCDR ;NO.
HRRZ FPD,-1(TEMP) ;SIZE OF ARRAY.
SKIPG -2(TEMP) ;STRING ARRAY?
HRRZ FPD,-2(TEMP) ;GET SIZE OF STRING ARRAY
ADDI FPD,(TEMP) ;ADDR LAST +1 ELEM OF ARRAY
CAIG FPD,(A) ;MUST BE GREATER THAT PARAM ADDR
JRST REMCDR ;ISN'T
;WE'RE REMEMBERING A SINGLE ELEMENT OF AN ALREADY SAVED ARRAY
MOVEI TEMP,(A) ;ADDR ARRAY ELEM TO BE SAVED
SUBI TEMP,(PNT) ;OFFSET OF ARRAY ELEM
ADD TEMP,1(C) ;ADDR SAVED ARRAY
TLNN A,ISSET ;SAVING A SET?
JRST ELNSET ;NO.
SKIPN FPD,(TEMP) ;ADDR LASTWORD,,FIRSTWORD
JRST RNOSET ;SET WAS NULL.
HLRZ PNT,(FPD) ;LASTWORD ADDR
HRR FP,FP1(TABL) ;HEAD OF ONE-WORD FREES
HRRM FP,(PNT) ;LINK IN RELEASED SET
HRRM FPD,FP1(TABL) ;NEW FREE-LIST
RNOSET:
SAVACS <(TEMP,LPSA,D)>
PUSH P,A ;SET TO BE COPIED
PUSH P,[0] ;NULL SET
GLOB<
TLZ FLAG,GLBSRC ;TURN OFF GLBSRC BIT
>;GLOB
PUSHJ P,CATLST ;LET CAT DO THE WORK
HLRE FLAG,(P) ;GET NEG LENGTH
MOVMS FLAG ;MAKE POS
HRLM FLAG,(P) ;STORE INTO SET DESCRIPTOR
POP P,FLAG ;SET DESCRIPTOR
RESTACS <(D,LPSA,TEMP)>
MOVEM FLAG,(TEMP) ;SAVE SET
JRST LPREM ;GET NEXT PARAM IF ANY
ELNSET:
TLNN A,ISSTR ;SAVING A STRING?
JRST REMESY ;NO.
HRROS A ;PREPARE FOR POP'S
POP A,(TEMP) ;2ND WORD STRING DESCRIPTOR
POP A,-1(TEMP) ;1ST WORD
JRST LPREM ;NEXT PARAM
REMESY:
MOVE FLAG,(A)
MOVEM FLAG,(TEMP)
JRST LPREM ;NEXT PARAM
REMCDR:
MOVEI B,(C) ;CDR CONTEXT LIST.
HRRZ C,(C)
TRZ C,DESC ;TURN OFF DESCRIPTOR BIT
JUMPN C,LPREM2 ;LOOP IF NOT AT END OF LIST
INSERT:
MOVE FP,FP2(TABL) ;TWO WORD FREE
MOVEI PNT,(FP) ;SAVE ADDR.
SKIPN FP,(FP) ;FOR NEXT TIME
PUSHJ P,FP2DON ;GET SOME MORE.
MOVEM FP,FP2(TABL) ;SAVE CDR FREE LIST
HRRM C,(PNT) ;CDR CONTEXT
DPB PNT,[POINT 17,(B),35] ;DON'T TOUCH PREVIOUS DESCP BIT
HRLM A,(PNT) ;THE REFERENCE
TLNN A,ISARR!ISSET!ISSTR ;A DESCRIPTOR TYPE OF THING?
JRST SCALAR ;NO.
MOVEI FLAG,DESC ;DESCRIPTOR BIT
ORM FLAG,(PNT) ;MARK AS DESCRIPTOR
TLNN A,ISARR ;AN ARRAY?
JRST NTARRY ;NO.
MOVEI B,(PNT)
;MAY WANT TO DELETE APPROPRIATE ARRAY ELEMENTS HERE
JUMPE C,REMVN2 ;IF NULL CDR
HRRZ FPD,-1(A) ;LENGTH OF ARRAY
SKIPG -2(A) ;STRING ARRAY?
HRRZ FPD,-2(A) ;LENGTH OF STRING ARRAY
ADDI FPD,(A) ;ADDR 1 PAST END OF ARRAY
PUSH P,A ;SAVE AC
PUSH P,FPD ;
LPREMV:
HLRZ FLAG,(C) ;CAND.
CAML FLAG,(P) ;WITHIN ARRAY?
JRST REMVND ;NO.
PUSHJ P,RELNOD ;RELEASE NODE
LDB C,[POINT =17,(B),=35]
JUMPN C,LPREMV
REMVND:
SUB P,X11 ;REMOVE HIGH ADDR OF ARRAY
POP P,A
REMVN2:
MOVE FLAG,A ;SAVE TYPE BITS LEFT HALF.
PUSH P,A ;PARAM TO ARCOP
PUSHJ P,ARCOP ;COPY THE ARRAY.
MOVE TABL,GOGTAB ;DON'T TRUST ARRAY ROUTINES
HRR FLAG,A ;READY TO SAVE ADDR.
MOVEM FLAG,1(B) ;SAVE ARRAY DESCRIPTOR
TLNN FLAG,ISSTR ;STRING ARRAY?
JRST NTSTR ;NO.
SKIPN FP,FP1(TABL) ;GET ONE WORD FREES.
PUSHJ P,FP1DON
MOVEI C,(FP) ;SAVE ADDR ONE WORD FREE
SKIPN FP,(FP) ;FOR NEXT TIME.
PUSHJ P,FP1DON ;IF OUT, GET MORE.
HRRM FP,FP1(TABL) ;SAVE CDR ONE-WORD FREE LIST
MOVE A,ARYLS(TABL) ;OLD STRING ARRAY LIST
HRRM A,(C) ;ADD NEW ELEMENT
HRLM FLAG,(C) ;ADDRESS STRING ARRAY
MOVEM C,ARYLS(TABL) ;SAVE STRING ARRAY LIST
JRST LPREM ;CONTINUE
NTSTR:
TLNN FLAG,ISSET ;SET ARRAY?
JRST LPREM ;NO.
SAVACS <(D,LPSA)>
SKIPN FP,FP1(TABL) ;ONE WORD FREES INITED?
PUSHJ P,FP1DON ;NO, GO DO IT.
HRRM FP,FP1(TABL)
PUSHJ P,COPARR ;COPY THE LIST ARRAY (ADDR IN A)
RESTACS <(LPSA,D)> ;RESTORE SAVED AC'S
JRST LPREM ;CONTINUE
NTARRY: ;NOT AN ARRAY
TLNE A,ISSTR ;A STRING?
JRST COPSTR ;MUST COPY STRING
TLNN A,ISSET ;HAD BETTER BE SET
ERR <DRYROT REMEMBER 2>
SAVACS <(LPSA,D,PNT)> ;SAVE AC'S WHICH WILL CHANGE
PUSH P,(A) ;SET TO BE COPIED
PUSH P,[0] ;NULL SET.
GLOB <
TLZ FLAG,GLBSRC ;TURN OFF GLBSRC BIT
>;GLOB
PUSHJ P,CATLST ;COPY SET
HLRE FLAG,(P) ;COUNT OF SET
MOVMS FLAG ;MAKE POS.
TRO FLAG,ISSET ;MARK AS SET DESCRIPTOR
HRLM FLAG,(P) ;
POP P,FLAG
RESTACS <(PNT,D,LPSA)> ;RESTORE AC'S
JRST COMMN
COPSTR: ;COPY STRING
PUSHJ P,SDESCR ;GET A STRING DESCRIPTOR
POP P,A ;NEW DESCRIPTOR
HLRO TEMP,(PNT) ;STRING TO BE COPIED
POP TEMP,(A) ;SECOND WORD
POP TEMP,-1(A) ;FIRST WORD
HRRZ FLAG,A
TLO FLAG,ISSTR ;MARK AS STRING DESCRIPTOR
JRST COMMN
SCALAR: ;SIMPLE SCALAR
MOVE FLAG,(A) ;VALUE
COMMN:
MOVEM FLAG,1(PNT) ;SAVE VALUE
JRST LPREM
REMREP: PUSH P,[LPREM] ;IN-LINE CALL
REP1:
COMMENT ⊗ REPLACE THE OLD SAVED VALUE WITH THE CURRENT VALUE.
C - ADDR CONTEXT NODE
CALLED WITH PUSHJ ⊗
;HERE MAY HAVE TO INSERT SPECIAL STUFF FOR HANDLING FIRST ELEM OF ARRAY
MOVE PNT,(C) ;FIND OUT IF DESCRIPTOR
HLRZ A,(C) ;ADDRESS OF SAVED VAR.
TRNE PNT,DESC ;A DESCRIPTOR?
JRST ISDESC ;YES.
MOVE FLAG,(A) ;VALUE
MOVEM FLAG,1(C) ;SAVE IT.
POPJ P, ;RETURN
ISDESC:
MOVE PNT,1(C) ;GET DESCRIPTOR
TLNE PNT,ISARR ;AN ARRAY?
JRST REPARR ;YES.
TLNE PNT,ISSTR ;SCALAR STRING?
JRST REPSTR ;YES.
TLNN PNT,ISSET ;HAD BETTER BE SET.
ERR <DRYROT - REMEMBER 1>
TRNN PNT,-1 ;SEE IF NULL SET
JRST SETREL ;YES, DON'T TRY TO RELEASE
MOVE FP,FP1(TABL) ;PREPARE TO RELEASE SET
HLRZ PNT,(PNT) ;ADDR END OF SET
HRRM FP,(PNT) ;LINK SET ONTO FREE-LIST
MOVE PNT,1(C) ;GET SET HEAD
HRRM PNT,FP1(TABL) ;SAVE FREE-LIST
SETREL:
SAVACS <(LPSA,D,C)> ;SAVE IMPORTANT AC'S
PUSH P,(A) ;SET TO BE COPIED
PUSH P,[0] ;NULL SET
GLOB<
TLZ FLAG,GLBSRC ;TURN OFF GLBSRC BIT
>;GLOB
PUSHJ P,CATLST ;LET CATLST COPY SET
POP P,TEMP
RESTACS <(C,D,LPSA)> ;RESTORE AC'S
HLRE FLAG,TEMP ;LENGTH OF SET
MOVMS FLAG ;MAKE POSITIVE
TRO FLAG,ISSET ;IS A SET DESCRIPTOR
HRLM FLAG,TEMP
MOVEM TEMP,1(C) ;SAVED SET
REPCOM:
POPJ P, ;RETURN TO WHOEVER.
REPSTR:
HRROI TEMP,(A) ;ADDR OF NEW STRING
POP TEMP,(PNT) ;SECOND WORD
POP TEMP,-1(PNT) ;FIRST WORD
POPJ P,
REPARR: ;REPLACE AN ARRAY
TLNN PNT,ISSET ;A SET ARRAY?
JRST REPESY ;NO, JUST AS EASY TYPE
PUSH P,PNT ;ADDRESS OF SAVED ARRAY
PUSHJ P,ARRRCL ;RECLAIM LIST SPACE
REPESY: ;BLT IN NEW CONTENTS
TLNE PNT,ISSTR ;A STRING ARRAY
JRST [SUBI PNT,1 ;STRING ARRAY
SUBI A,1 ;ALSO NEW ARRAY
JRST .+1]
HRRZ FLAG,-1(PNT) ;SIZE OF ARRAY
ADDI FLAG,-1(PNT) ;LAST WORD TO BE SAVED
HRLI A,(PNT) ;ADDR FIRST WORD IN COPY OF ARRAY
MOVSS A ;PREPARE FOR BLT
BLT A,(FLAG) ;BLT ARRAY
TLNN PNT,ISSET ;SET ARRAY?
POPJ P, ;NO,RETURN.
SAVACS <(C,D,LPSA)>
PUSHJ P,COPARR ;COPY THE ELEMENTS ADDR ARRAY IN A
RESTACS <(LPSA,D,C)>
POPJ P, ;RETURN
RETALL: PUSH P,LPSA ;THE RETURN ADDRESS
JRST STACRS ;RESTORE AC'S
DSCR FORGET ⊗
HERE(FORGET) ;FORGET NAMED VARIABLES
PUSHJ P,STACSV ;SAVE OFF AC'S
MOVE TABL,GOGTAB ;USER TABLE
POP P,LPSA ;RETURN ADDRESS
POP P,D ;CONTEXT ADDRESS
LPFORG: POP P,A ;THE VARIABLE'S ADDRESS
JUMPE A,RETALL ;IF NONE, RETURN
TLNE A,ISARR ;IF ARRAY GET DESCRIPTOR
HRR A,(A)
TLNN A,-1
ERR <DRYROT AT FORGET- NO DESCRIPTOR>,1
SKIPN C,(D) ;HEAD OF CONTEXT LIST
NTTHER: ERR <FORGETTING UNREMBERED VARIABLE>,1,LPFORG
MOVEI B,(D) ;BACK POINTER
LPFOR2:
HLRZ PNT,(C) ;CANDIDATE
CAIN PNT,(A) ;RIGHT ONE?
JRST FNDNOD ;THE SAME.
CAIL PNT,(A) ;FURTHER DOWN LIST?
JRST NTTHER ;NO, SIGNAL ERROR
MOVEI B,(C) ;CDR LIST
HRRZ C,(C)
TRZ C,DESC
JUMPN C,LPFOR2 ;LOOP
JRST NTTHER ;WASN'T IN CONTEXT
FNDNOD: ;FOUND IN CONTEXT TO RELEASE
PUSH P,[LPFORG] ;IN LINE CALL
RELNOD: ;TO GENERALLY RELEASE NODE
;B CONTAINS BACKPOINTER,C THIS NODES ADDR.
MOVE PNT,(C) ;FIRST UNLINK NODE
DPB PNT,[POINT 17,(B),35]
TRNN PNT,DESC ;HARD CASE?
JRST FORESY ;NO
MOVE PNT,1(C) ;GET DESCRIPTOR
TLNE PNT,ISARR ;ANY KIND OF ARRAY?
JRST FORARR ;YES
TLNE PNT,ISSTR ;A SCALAR STRING?
JRST FORSTR ;YES
TLNN PNT,ISSET ;SHOULD BE THIS TYPE
ERR <DRYROT - FORGET 1>
TRNN PNT,-1 ;NULL SET
JRST FORESY ;YES
HLRZ FLAG,(PNT)
MOVE FP,FP1(TABL) ;OLD FREE-LIST
HRRM FP,(FLAG) ;LINK ONTO RELEASED SET
HRRM PNT,FP1(TABL) ;SET RECLAIMED
JRST FORESY ;NOTHING TO IT.
FORSTR:
SETZM -1(PNT) ;MAKE INTO NULL STRING
HLRZ FLAG,HASHP(TABL) ;STRING DESCRIPTOR LIST
HRRM FLAG,(PNT) ;LINK DESCRIPTOR ONTO FREE LIST
HRLM PNT,HASHP(TABL) ;ALL DONE
JRST FORESY
FORARR: ;AN ARRAY
TLNN PNT,ISSET!ISSTR ;SIMPLE ARRAY?
JRST FARESY ;YUPP!
TLNN PNT,ISSTR ;SET ARRAY
JRST FSTARY ;YES.
SETZM
;STRING ARRAY MUST BE REMOVED FROM ARYLS LIST
MOVEI TEMP,ARYLS(TABL) ;BACK POINTER
JRST ENDSRY ;JUMP TO TEST
LPSARY: HLRZ FLAG,(FPD) ;CANDIDATE
CAIN FLAG,(PNT) ;GOT IT?
JRST FNDARY ;YES
MOVEI TEMP,(FPD) ;FOR NEXT TIME
ENDSRY: SKIPE FPD,(TEMP) ;GET NEXT CANDIDATE.
JRST LPSARY ;LOOP
ERR <DRYROT FORGET 2>
FNDARY:
HRRZ FLAG,(FPD) ;LINK TO NEXT IN ARYLS
HRRM FLAG,(TEMP) ;DELETE NODE FROM LIST
HRR FP,FP1(TABL) ;PREPARE TO RELEASE FREE
HRRM FP,(FPD)
HRRM FPD,FP1(TABL) ;DONE
JRST FARESY
FSTARY:
PUSH P,(PNT) ;ARRAY ADDRESS
PUSHJ P,ARRRCL ;RECLAIM LIST SPACE
FARESY:
SAVACS <(B,C,D,LPSA)>
PUSH P,PNT ;ARRAY TO BE RELEASED
PUSHJ P,ARYEL ;RELEASE IT
RESTACS <(LPSA,D,C,B)>
MOVE TABL,GOGTAB
FORESY:
MOVE FP,FP2(TABL) ;PREPARE TO RELEASE TWO WORD FREE
MOVEM FP,(C)
HRRM C,FP2(TABL)
POPJ P, ;RETURN TO WHOEVER
DSCR RESTOR RESTORE CONTENTS OF VARIABLES ⊗
HERE(RESTOR) ;ENTRY
PUSHJ P,STACSV
MOVE TABL,GOGTAB ;SET UP USER TABLE REG.
POP P,LPSA ;RETURN ADDR
POP P,D ;CONTEXT ADDR
LPRES:
POP P,A ;ADDR VAR TO BE RESTORED
JUMPE A,RETALL ;RETURN WHEN THROUGH
TLNE A,ISARR
HRR A,(A)
TRNN A,-1
ERR <DRYROT AT RESTOR>
HRRZ C,(D) ;ADDR FIRST NODE IN LIST
LPRES2:
JUMPE C,RESERR ;ERROR IF NIL LIST.
HLRZ PNT,(C) ;REFERENCE
CAIN PNT,(A) ;THE SAME?
JRST RESFND ;YES.
HRRZ FLAG,(C) ;DESC BIT&LINK
TRZN FLAG,DESC ;TURN OFF DESC,IF DESC STILL POSSIBILITY
JRST RESCDR
MOVE B,1(C) ;THE DESCRIPTOR
TLNN B,ISARR ;AN ARRAY?
JRST RESCDR ;NO.
MOVE FP,PNT ;ADDR ARRAY
TLNE B,ISSTR ;STRING ARRAY?
SUBI FP,1 ;SUB 1 FOR STRING ARRAY
HRRZ FP,-1(FP) ;LENGTH OF ARRAY
ADDI FP,(PNT) ;ADDR LAST ELEM IN ARRAY
CAIL FP,(A) ;IS VAR IN THIS ARRAY
CAILE PNT,(A) ;
JRST RESCDR ;NO
HRROI TEMP,(A) ;ADDR OF ELEM TO BE RESTORED
SUBI TEMP,(PNT) ;OFFSET
ADDI TEMP,(B) ;ADDR IN SAVED ARRAY.
TLNN B,ISSET!ISSTR ;HARD TYPE?
JRST RESES1 ;NO.
TLNN B,ISSET ;A SET
JRST ISSTR ;NO A STRING
SAVACS <(LPSA,D,A)> ;SAVE IMPORTANT AC'S
PUSH P,(TEMP) ;SET TO BE COPIED
PUSH P,[0] ;NIL SET
PUSHJ P,CATLST ;LET CAT DO THE WORK
RESTACS <(A,D,LPSA)> ;RESTORE AC'S
HLRE FLAG,(P) ;COUNT
MOVMS FLAG ;MAKE POSITIVE FOR PERM. SET.
HRLM FLAG,(P) ;PUT IT BACK
POP P,(A) ;SAVE THE SET
JRST LPRES ;NEXT ONE
RESCDR:
MOVEI B,(C)
HRRZ C,(C)
TRZ C,DESC
JRST LPRES2
RESERR:
ERR <RESTORE UNREMEMBERED VARIABLE>,1
JRST LPRES2
RE1STR: ;A STRING WITHIN A STRING ARRAY
POP TEMP,(A)
POP TEMP,-1(A)
JRST LPRES
RESES1:
MOVE FLAG,(TEMP)
MOVEM FLAG,(A)
JRST LPRES
RESFND: ;FOUND MATCH
PUSH P,[LPRES] ;IN-LINE CALL
RESNOD: ;RESTORE NODE ADDR IN C.
MOVE TEMP,(C) ;GET ENTIRE FIRST WORD.
HLRZ PNT,TEMP ;PLACE TO BE RESTORED TO.
MOVE FLAG,1(C) ;THE DESCRIPTOR, OR VALUE.
TRNN TEMP,DESC ;A DESCRIPTOR?
JRST RESESY ;NO.
TLZE FLAG,ISARR ;AN ARRAY?
JRST RESAR2 ;YES.
TLZN FLAG,ISSET ;A SET?
JRST RESSTR ;NO, A STRING.
SKIPN TEMP,(PNT) ;IS SET TO BE REPLACED NULL
JRST RESST2 ;YES
HLRZ B,(PNT) ;LAST NODE IN SET
MOVE FP,FP1(TABL) ;END OF FREE-LIST
HRRM FP,(B) ;CAT ONTO RELEASED SET
HRRM PNT,FP1(TABL) ;SAVE NEW FREE-LIST
RESST2:
SAVACS <(LPSA,D,C)>
PUSH P,FLAG
PUSH P,[0]
GLOB <
MOVEI FLAG,0 ;MAKE SURE GLB BIT OFF
>;GLOB
PUSHJ P,CATLST ;LET CAT DO THE WORK
HLRE FLAG,(P) ;RESULTANT SET
MOVMS FLAG ;MAKE INTO PERM SET.
HRLM FLAG,(P)
POP P,FLAG ;GET THE SET BACK
RESTACS <(C,D,LPSA)>
HLRZ PNT,(C)
MOVEM FLAG,(PNT) ;SAVE THE NEW SET.
POPJ P, ;RETURN
RESSTR: ;RESTORE A SCALAR STRING
HRROI FLAG,(FLAG) ;PREPARE FOR POP'S
POP FLAG,(PNT) ;SECOND WORD
POP FLAG,-1(PNT) ;FIRST WORD
POPJ P, ;RETURN
RESESY: ;SIMPLE SCALAR
MOVEM FLAG,(PNT) ;RESTORE VALUE
POPJ P, ;RETURN
RESAR2: ;RESTORE ENTIRE ARRAY
TLNN FLAG,ISSET ;A SET ARRAY?
JRST RESAR3 ;NO
PUSH P,PNT ;PREPARE TO RECLAIM LIST SPACE
PUSHJ P,ARRRCL ;RECLAIM IT
RESAR3:
TLNN FLAG,ISSTR ;A STRING ARRAY
JRST RESAR4 ;NO.
SUBI PNT,1
SUBI FLAG,1
RESAR4: ;GET READY TO BLT
HRRZ B,-1(PNT) ;NUMBER OF WORDS
ADDI B,-1(PNT) ;ADDR LAST WORD
HRLI PNT,(FLAG) ;BLT WORD
BLT PNT,(B) ;DO BLT
TLNN FLAG,ISSET ;SET ARRAY?
POPJ P, ;NO.
SAVACS <(LPSA,D,C)>
MOVEI A,(PNT) ;ADDR ARRAY TO BE COPIED
PUSHJ P,COPARR ;COPY LISTS WITHIN ARRAY
RESTACS <(C,D,LPSA)> ;RESTORE AC'S
POPJ P,
DSCR ALLRM,ALLFOR,ALLRS.
REMEMBER ALL IN CONTEXT;
FORGET ALL IN CONTEXT;
RESTORE ALL IN CONTEXT;
CONTEXT ADDR IN -1(P) ⊗
HERE(ALLRM) ;REMEMBER ALL
PUSHJ P,STACSV
MOVE TABL,GOGTAB ;USER TABLE
HRRZ C,@-1(P) ;FIRST IN CONTEXT LIST
LPALLR:
JUMPE C,ENDALL ;PROCESSED EVERYTHING IN CONTEXT?
PUSHJ P,REP1 ;ALTER THIS NODE.
HRRZ C,(C) ;CDR CONTEXT LIST.
TRZ C,DESC ;TURN OFF DESC BIT
JRST LPALLR ;LOOP
ENDALL:
PUSHJ P,STACRS
SUB P,X22 ;PREPARE TO RETURN
JRST @2(P) ;RETURN
HERE(ALLFOR) ;FORGET ALL
PUSHJ P,STACSV
MOVE TABL,GOGTAB ;USER TABLE
MOVEI B,@-1(P) ;ADDR CONTEXT LIST HEAD
LPALLF:
SKIPN C,(B) ;NEXT NODE IN CONTEXT LIST
JRST ENDALL ;NONE LEFT.
PUSHJ P,RELNOD ;RELEASE THIS NODE
JRST LPALLF ;LOOP
HERE(ALLRS) ;RESTORE ALL
PUSHJ P,STACSV
MOVE TABL,GOGTAB
MOVE C,@-1(P) ;FIRST NODE IN CONTEXT LIST
LPRESA:
JUMPE C,ENDALL ;NONE LEFT?
PUSHJ P,RESNOD ;RESTORE THIS NOD
HRRZ C,(C) ;CDR CONTEXT LST
TRZ C,DESC
JRST LPRESA
DSCR GFREES ⊗
GLOB <
GFREES: ;ATTEMPT TO USE WASTED SPACE IN INFOTAB,DATAB
PUSHJ P,FSAV ;SAVE AC'S (PROBABLY NOT NECESSARY)
MOVE B,ITMTOP(USER) ;MAX LOCAL ITEM NUMBER
MOVEI C,GBRK ;BEGINNING OF GLOBALS
CAIL B,-20(C) ;WON'T EVEN TRY IF LESS THAN 20 SPACES
JRST FREST ;RESTORE AC'S AND RETURN
SUBI C,2(B) ;COUNT OF FREE SPACES
PUSH P,C ;SAVE FOR LATER
ADD B,INFOTAB(USER) ;
ADDI B,1 ;ONE MORE
HRRM B,FP1(USER) ;BEGINNING OF LIST OF AVAILABLE SPACE
ADDI B,1 ;GET READY TO LINK UP.
HRRZM B,-1(B) ;LINK UP.
SOJG C,.-2 ;LOOP UNTIL DONE
SETZM (B) ;LAST LINK IS NIL.
HRLM B,FP1(USER) ;ADDRESS LAST FREE CELL
POP P,C ;NUMBER OF FREE CELLS
LSH C,-1 ;DIVIDE BY 2
MOVE B,DATAB(USER)
ADD B,ITMTOP(USER) ;ADDRESS FIRST AVAIL TWO-WORD FREE -1.
ADDI B,1 ;ADDRESS FIRST TWO-WORD FREE
HRRZM B,FP2(USER) ;BEGINNING OF LIST OF AVAIL. SPACE
ADDI B,2 ;LINKING THEM UP.
HRRZM B,-2(B) ;LINK.
SOJG C,.-2 ;LOOP UNTIL DONE
SETZM (B) ;LAST LINK IS NIL
PUSHJ P,FREST ;RESTORE AC'S
HRROS UUO1(USER) ;DON'T NEED MORE FREES
POPJ P,
>;GLOB
;GET BOTH KINDS OF FREE STORAGE.
FPEES: PUSHJ P,FP2DON ;GO GET FREE STORAGE.
DSCR FP1DON FP2DON
THESE ARE THE ROUTINES FOR GETTING MORE FREE STORAGE FROM
THE MAIN CORE ALLOCATORS. FP1DON GETS 1 WORD FREES, FP2DON
GETS 2 WORD FREES. THEY ARE GENERALLY CALLED UNDER A SKIPN FP,(FP)
AND RETURN FP POINTING TO THE HEAD OF THE NEW FREE STORAGE LIST.
FP1DON DOES A SPECIAL THING -- THE LAST ELEMENT OF THE OLD FREE
STORAGE LIST IS LINKED TO THE FIRST ELEMENT OF THE NEW ONE -- THIS
IS SO THAT SETS (I.E. LINKED LISTS) CAN BE MADE IN ONE PIECE,
WITHOUT WORRYING ABOUT LINKING THE INDIVIDUAL CELLS TOGETHER.
ACS SAVED -- ALL
AC RESULT -- FP HAS NEW POINTER.
⊗;
HERE(FP1DON)
PUSHJ P,FSAV
LPCOR (FREELEN,) ;GET THE CORE
HRRM B,FP1(TABL)
HRRZM B,SGACS+FP(USER)
HLRZ C,FP1(TABL) ;THIS WAS THE LAST WORD BEFORE.
SKIPE C ;NONE THERE
HRRM B,(C) ;LINK IT DOWN....
MOVNI A,FREELEN-1
ADDI B,1
HRRZM B,-1(B) ;LINK UP THE LIST
AOJL A,.-2
SETZM (B)
HRLM B,FP1(TABL) ;SAVE ADDR OF LAST FREE FOR LINKING
JRST FREST ;AND DONE.
HERE(FP2DON)
PUSHJ P,FSAV
LPCOR (FREELEN,FP2)
HRRZM B,SGACS+FP(USER)
MOVNI A,FREELEN/2-1
ADDI B,2
HRRZM B,-2(B)
AOJL A,.-2 ;LINK UP.
SETZM (B)
; JRST FREST
FREST: MOVSI 14,SGACS(USER)
BLT 14,14
POPJ P,
FSAV: MOVEM 14,SGACS+14(USER)
MOVEI 14,SGACS(USER)
BLT 14,SGACS+13(USER)
POPJ P,
DSCR SDESCR - GET A TWO WORD STRING DESCRIPTOR
A LIST OF TWO WORD STRING DESCRIPTORS (COLLECTABLE BY
GARBAGE COLLECTOR) IS HEADED IN LEFT-HALF HASHP(USER).
THIS ROUTINE WILL RETURN CAR OF THIS LIST ON TOP OF
STACK AND IF LIST IS NULL WILL ALLOCATE A NEW
STRING ARRAY, LINK THAT ARRAY INTO THE LIST OF STRING
ARRAYS (ARYLS(USER)) AND LINK TOGETHER THE INDIVIDUAL
ARRAY ELEMENTS TO FORM A NEW LIST OF STRING DESCRIPTORS.
ALL AC'S ARE RESTORED TO THEIR PREVIOUS VALUES BEFORE
EXIT FROM THE ROUTINE. ⊗
HERE(SDESCR) ;ENTRY-POINT
ADD P,[XWD 15,15] ;WILL SAVE AC'S ON STACK
SKIPL P ;STACK OVERFLOW?
PDLOF ;YES.
PUSH P,USER ;SAVE USER ALSO.
HRRI USER,-15(P) ;ADDR. WHERE 0 TO BE SAVED
BLT USER,-1(P) ;SAVE AC'S 0 TO 14
MOVE USER,GOGTAB ;USER TABLE
HLRZ A,HASHP(USER) ;ANY FREE DESCRIPTORS.
JUMPN A,UNLINK ;IF YES, TAKE CAR.
SKIPE HASHP(USER) ;PNAMES ALSO
JRST NOINIT ;ALREADY INITED.
MOVEI C,0 ;COUNT OF PNAMES REQUIRED
MOVE A,SPLNK(USER) ;SPACE ALLOCATION BLOCK LIST
PNMCNT: JUMPE A,HAVCNT ;THROUGH WITH ALLOCATION BLOCKS
CAMGE C,$PNMNO(A) ;MORE THAN THIS PROG REQUIRES?
MOVE C,$PNMNO(A) ;NO.
HRRZ A,(A) ;CDR ALLOCATION LIST
JRST PNMCNT ;LOOP
HAVCNT: CAIG C,50 ;AT LEAST 50?
NOINIT: MOVEI C,50 ;STANDARD SIZE IS 50
PUSH P,[0] ;MAKE THE STRING ARRAY
PUSH P,C ;UPPER BOUND
PUSH P,[XWD -1,1] ;INDICATE STRING ARRAY
MOVE C,UUO1(USER) ;SINCE ARMAK WILL DESTROY
PUSHJ P,ARMAK ;MAKE THE ARRAY
MOVE USER,GOGTAB
MOVEM C,UUO1(USER) ;RESTORE UUO1
SKIPN FP,FP1(USER) ;ONE-WORD FREE'S INITED?
PUSHJ P,FP1DON ;NO.
MOVEI B,(FP) ;ADDR. ONE-WORD FREE
SKIPN FP,(FP) ;FOR NEXT TIME
PUSHJ P,FP1DON ;IF OUT, GET MORE.
HRRM FP,FP1(USER) ;SAVE FREE-LIST
HRLI D,(A) ;ADDRESS NEW STRING ARRAY
HRR D,ARYLS(USER) ;LINK IN OLD ARRAY LIST
MOVEM D,(B) ;INTO ONE-WORD FREE
HRRM B,ARYLS(USER) ;NEW STRING ARRAY LIST.
MOVN C,-4(A) ;LENGTH OF ARRAY
HRL A,A ;
ADDI A,2
INT2: HLRM A,(A) ;LINK THEM UP
ADD A,X22
AOJL C,INT2 ;LOOP.
HLR A,A ;FREE STRING DESCRIPTOR LIST
UNLINK: ;HEAD OF DESCRIPTOR LIST IN A
HRRZ B,(A) ;CDR DESCRIPTOR LIST
HRLM B,HASHP(USER) ;SAVE CDR
SETZM -1(A) ;MAKE INTO NIL STRING
EXCH A,-16(P) ;EXCHANGE WITH RETURN ADDR
PUSH P,A ;SAVE RETURN ADDR.
HRLZI USER,-16(P) ;ADDR WHERE AC 0 SAVED
BLT USER,USER ;RESTORE AC'S
SUB P,[XWD 17,17] ;RESTORE STACK
JRST @17(P) ;RETURN
BEND LEAP
XLIST ;EXPURGATE SYMBOLS
IFN SEGS,<LIT
VAR
DEPHASE
END UPWRT>
END